%% @author Robert Ahrens <mindangels@yahoo.com>
-module(prun).
-export([
         %%unify/3, 
         external_call/3,
         unify/4,
         %%run_query/4,
         var/1,
         test_db/0
        ]).

-compile(export_all).

-define(is_primitive(X), (is_atom(X) orelse is_number(X))).

-define(v(V), {var, V}).

%% This is the first working version of this module, saved as a backup right
%% after I first got scoped variables working properly.  I'm going to go
%% ahead and keep hacking on the main prun file, as well as removing
%% a lot of cruft code that isn't getting called and so on.  But I'm keeping
%% this here as a record, as well as a place to come back to if I end up
%% needing to back out of changes in the main prun.
%%     Yes, I know I should just suck it up and use version control, but
%% really.  Some day I maybe will.
%%


var(X) when is_atom(X) -> ?v(X).


mk_var() ->
    ?v(list_to_atom(erlang:ref_to_list(make_ref()))).


external_call(RuleName, Args, DB) 
  when is_atom(RuleName) andalso is_list(Args) ->
    call_rule(RuleName, Args, [], DB).


call_rule(RuleName, ArgSchema, Bindings, DB) ->
    case reify_args(ArgSchema, Bindings, DB) of
        {ok, InitialArgs, Bind2, DB2} ->
            ClauseList = lookupdb(RuleName, DB),
            try_clauses(ClauseList, InitialArgs, Bind2, DB2);
        fail ->
            fail
    end.


%% Iterate over Schema and bind in each member.  Either return
%% {ok, InitialArgs, FinalBindings, FinalDB} if successful
%% %% or else fail.
%% @todo Use do_ground here to really bind the values from
%% anywhere in Bindings!
reify_args(Schema, Bindings, DB) ->
    reify_args(Schema, Bindings, DB, []).


reify_args([Spec|Rest], Bindings, DB, ArgsAcc) ->
    case try_expr(Spec, Bindings, DB) of
        {ok, Val, Bind2, DB2} ->
            reify_args(Rest, Bind2, DB2, [Val|ArgsAcc]);
        fail ->
            fail
    end;
reify_args([], Bindings, DB, ArgsAcc) ->
    {ok, lists:reverse(ArgsAcc), Bindings, DB}.


%% NOTE: This approach isn't tail recursive and therefore isn't
%% scaleable as a language implementation.  But I am trying to
%% be correct first and worry about that later.
try_clauses([], _ArgVals, _OuterBindings, _DB) ->
    fail;
%% try_clauses([{fact, ArgSpec}|OFacts], ArgVals, OuterBindings, DB) ->
%%     case unify(ArgSpec, ArgVals, [], DB) of
%%         fail ->
%%             try_clauses(OFacts, ArgVals, OuterBindings, DB);
%%         Bindings ->
%%             {ok, true, reconcile_bindings(ArgSpec, ArgVals, Bindings, OuterBindings, DB), DB}
%%     end;
try_clauses([{rule, {ArgSpec, ExprList}}|ORules], ArgVals, OuterBindings, DB) ->
    %%?NOTE: Deliberately start with no "extra" bindings 
    %% other than what's passed in as ArgVals.
    case unify(ArgSpec, ArgVals, [], DB) of
        fail ->
            try_clauses(ORules, ArgVals, OuterBindings, DB);
        InitialBindings ->
            case try_expressions(ExprList, InitialBindings, DB) of
                {ok, Value, FinalBindings, DB2} ->
                    case return_bindings(ArgVals, ArgSpec, FinalBindings, OuterBindings, DB) of
                        {ok, DoneBinding} ->
                            {ok, Value, DoneBinding, DB2};
                        fail ->
                            try_clauses(ORules, ArgVals, OuterBindings, DB)
                    end;
                fail ->
                    try_clauses(ORules, ArgVals, OuterBindings, DB)
            end
    end.


%% 3rd (hah!!!) attempt ...
return_bindings(ArgVals, _ArgSpec, FinalBindings, OuterBindings, _DB) ->
    VarsSought = contains_vars(ArgVals),
    case get_all_bindings(VarsSought, FinalBindings, []) of
        fail ->
            fail;
        {ok, Bindings} ->
            {ok, Bindings ++ OuterBindings}
    end.


get_all_bindings([H|T], Bindings, Acc) ->
    case get_binding(H, Bindings) of
        none ->
            fail;
        BVal = {H, _} ->
            get_all_bindings(T, Bindings, [BVal|Acc])
    end;
get_all_bindings([], _, Acc) ->
    {ok, Acc}.


%% NOTE: do_ground may have been pointless.  I hope so ....  Oh well.
%%     case do_ground(ArgVals, FinalBindings, []) of
%%         {ok, Res, _FB2} ->
%%             {ok, Res ++ OuterBindings};
%%         fail ->
%%             fail
%%     end.


do_ground([AVH|AVT], Bindings, Acc) ->
    case ground(AVH, Bindings) of
        {ok, AVV, Bind2} ->
            do_ground(AVT, Bind2, [AVV|Acc]);
        fail ->
            fail
    end;
do_ground([], Bindings, Acc) ->
    {ok, lists:reverse(Acc), Bindings}.


%% NOTE: I suspect this may be highly redundant, but I'm not
%% entirely sure.  So for now we will leave it in and then look
%% to yank it in the future.
ground(P, Bindings) when ?is_primitive(P) ->
    {ok, P, Bindings};
ground(?v(X), Bindings) when is_atom(X) ->
    case get_binding(X, Bindings) of
        none ->
            {ok, ?v(X), Bindings};
        {X, BoundVal} ->
            {ok, BoundVal, Bindings};
        Quoi ->
            throw({"didn't expect", Quoi})
    end;
ground(T, Bindings) when is_tuple(T) ->
    case ground(tuple_to_list(T), Bindings) of
        {ok, Lst, Bind2} ->
            {ok, list_to_tuple(Lst), Bind2};
        fail ->
            fail
    end;
ground([H|T], Bindings) ->
    case ground(H, Bindings) of
        {ok, H2, Bind2} ->
            case ground(T, Bind2) of
                {ok, T2, Bind3} ->
                    {ok, [H2|T2], Bind3};
                fail ->
                    fail
            end;
        fail ->
            fail
    end;
ground([], Bindings) ->
    {ok, [], Bindings}.


contains_vars(?v(X)) ->
    [X];
contains_vars(P) when ?is_primitive(P) ->
    [];
contains_vars([H|T]) ->
    case contains_vars(H) of
        [] -> contains_vars(T);
        SomeVars -> SomeVars ++ contains_vars(T)
    end;
contains_vars([]) ->
    [];
contains_vars(Tup) when is_tuple(Tup) ->
    contains_vars(tuple_to_list(Tup)).


%% %% Reconcile InnerBindings (result of walking the expression list)
%% %% with OuterBindings (the calling context) to produce an updated
%% %% context to be handed on to the next call.
%% reconcile_bindings(ArgSpec, OuterVals, InnerBindings, OuterBindings, DB) ->
%% %%    throw({not_yet_implemented,
%% %%           not_sure_how,
%% %%           {InnerBindings, OuterBindings}}).
%%     io:format("Called on to reconcile: ~n~p~n~p~n~p~n~p~n~n",
%%               [ArgSpec, OuterVals, InnerBindings, OuterBindings]),
%%     case reify_args(ArgSpec, InnerBindings, DB) of
%%         {ok, FinalVals, FinalBind, FinalDB} ->
%%             io:format("About to unify ~p with ~p...~n", [FinalVals, OuterVals]),
%%             unify(FinalVals, OuterVals, OuterBindings, FinalDB);
%%         fail ->
%%             throw("This isn't supposed to happen at this stage!")
%%     end.


try_expressions([], Bindings, DB) ->
    {ok, null, Bindings, DB};
try_expressions([Expr|Rest], Bindings, DB) ->
    case try_expr(Expr, Bindings, DB) of
        {ok, Value, Bind2, DB2} ->
            case Rest of
                [] -> {ok, Value, Bind2, DB2};
                _ -> try_expressions(Rest, Bind2, DB2)
            end;
        fail ->
            fail
    end.


%% @spec try_expr(Expr, Bindings, DB) -> {ok, Value, Bind2, DB2} | fail
%% @todo Why the hell are we returning a Value?  It's not Prolog and
%% it just complicates things.  Get rid of it!!!
try_expr({rule, {Name, ArgSchema}}, Bindings, DB) ->
    call_rule(Name, ArgSchema, Bindings, DB);

try_expr({erlang, {M, F, AList}}, Bindings, DB) ->
    case reify_args(AList, Bindings, DB) of
        {ok, ExprArgs, Bind2, DB2} ->
            {ok, apply(M, F, ExprArgs), Bind2, DB2};
        fail ->
            fail
    end;

try_expr({unify, SubEx1, SubEx2}, Bindings, DB) ->
    case try_expr(SubEx1, Bindings, DB) of
        {ok, Val1, Bind2, DB2} ->
            case try_expr(SubEx2, Bind2, DB2) of
                {ok, Val2, Bind3, DB3} ->
                    unify(Val1, Val2, Bind3, DB3);
                fail ->
                    fail
            end;
        fail ->
            fail
    end;

try_expr({var, X}, Bindings, DB) ->
    case get_binding(X, Bindings) of
        none ->
            {ok, {var, X}, Bindings, DB};
        {X, BoundVal} ->
            {ok, BoundVal, Bindings, DB}
    end;

try_expr(P, Bindings, DB) when ?is_primitive(P) ->
    {ok, P, Bindings, DB};

try_expr([H|T], Bindings, DB) ->
    case try_expr(H, Bindings, DB) of
        {ok, VH, Bind2, DB2} ->
            case try_expr(T, Bind2, DB2) of
                {ok, VT, Bind3, DB3} ->
                    {ok, [VH|VT], Bind3, DB3};
                fail ->
                    fail
            end;
        fail ->
            fail
    end;

try_expr([], Bindings, DB) ->
    {ok, [], Bindings, DB};

try_expr(Tup, Bindings, DB) when is_tuple(Tup) ->
    case try_expr(tuple_to_list(Tup), Bindings, DB) of
        {ok, ListOVals, Bind2, DB2} ->
            {ok, list_to_tuple(ListOVals), Bind2, DB2};
        fail ->
            fail
    end.


get_binding(VarName, Bindings) ->
    proplists:lookup(VarName, Bindings).


add_binding(Var, Val, Bindings) ->
    [{Var, Val} | Bindings].


occurs_in(VarName, {var, VarName}) ->
    true;
occurs_in(_, {var, _}) ->
    false;
occurs_in(_, P) when ?is_primitive(P) ->
    false;
occurs_in(VarName, Tuple) when is_tuple(Tuple) ->
    occurs_in(VarName, tuple_to_list(Tuple));
occurs_in(VarName, [H|T]) ->
    case occurs_in(VarName, H) of
        true -> true;
        false -> occurs_in(VarName, T)
    end;
occurs_in(_, []) ->
    false.


lookupdb(QName, Database) ->
    [{Type, Data} || {Type, Name, Data} <- Database, Name == QName].


try_binding({var, X}, {var, X}, Bindings, _DB) -> 
    Bindings;
try_binding({var, X}, Pattern, Bindings, DB) ->
  case get_binding(X, Bindings) of
      none ->
          case occurs_in(X, Pattern) of
              true ->
                  fail;
              false ->
                  add_binding(X, Pattern, Bindings)
          end;
      {X, BoundVal} ->
          unify(BoundVal, Pattern, Bindings, DB)
  end.


%% @spec unify(pterm(), pterm(), bindings(), database()) -> {ok, bindings(), database()} | fail
unify(_, _, fail, _) -> 
    fail;
unify({var, X}, Pattern, Bindings, DB) ->
    try_binding({var, X}, Pattern, Bindings, DB);
unify(Pattern, {var, Y}, Bindings, DB) ->
    try_binding({var, Y}, Pattern, Bindings, DB);
unify(X, X, Bindings, _DB) when ?is_primitive(X) ->
    Bindings;
unify(X, _, _Bindings, _DB) when ?is_primitive(X) ->
    fail;
unify(_, Y, _Bindings, _DB) when ?is_primitive(Y) ->
    fail;
unify(T1, T2, Bindings, DB) 
  when is_tuple(T1) andalso is_tuple(T2) ->
    if
        size(T1) == size(T2) ->
            unify(tuple_to_list(T1), tuple_to_list(T2), Bindings, DB);
        true ->
            fail
    end;
unify([H1|T1], [H2|T2], Bindings, DB) ->
    case unify(H1, H2, Bindings, DB) of
        fail ->
            fail;
        Bind2 ->
            unify(T1, T2, Bind2, DB)
    end;
unify([], [], Bindings, _DB) ->
    Bindings;
unify(_, _, _, _) ->
    fail.


test_db() ->
    [{rule,liked_by,
      {[{var,'M'},{var,'N'}],[{rule, {likes,[{var,'N'},{var,'M'}]}}]}},
     {fact,likes,[zoa,sarah]},
     {fact,likes,[robert,sarah]},
     {fact,likes,[zoa,milk]},
     {fact,likes,[robert,cheese]}].


%% NOTE: This syntax is fubared.  Better to write:
%%
%% test_db() ->
%%     [{rule, liked_by, [?v('M'), ?v('N')],    %% head
%%       [{rule, likes, [?v('N'), ?v('M')]}]},  %% body
%%      {rule, likes, [zoa, sarah], []},        %%
%%      {rule, likes, [robert, sarah], []},     %% no body -- "facts"
%%      {rule, likes, [zoa, milk], []},
%%      {rule, likes, [robert, cheese], []}
%%     ].
%%
%% Obviously, this will require rewriting lookupdb, try_expr
%% and a bunch more, but I think it'll be worth it for the clarity.
%%
